home *** CD-ROM | disk | FTP | other *** search
/ Software Vault: The Gold Collection / Software Vault - The Gold Collection (American Databankers) (1993).ISO / cdr01 / jock.zip / TOTSRC11.ZIP / TOTINPUT.PAS < prev    next >
Pascal/Delphi Source File  |  1993-05-04  |  32KB  |  1,252 lines
  1. {               Copyright 1991 TechnoJock Software, Inc.               }
  2. {                          All Rights Reserved                         }
  3. {                         Restricted by License                        }
  4.  
  5. {                             Build # 1.10a                            }
  6.  
  7. Unit totINPUT;
  8. {$I TOTFLAGS.INC}
  9.  
  10. {
  11.  Development Notes:
  12.        1.00a  3/28/91   Add Mouse method SetForceOff to stop Toolkit
  13.                         making the mouse visible;
  14.        1.00b  5/23/91   Corrected ret codes with Mouse method 1
  15.        1.00c  6/02/91   Changed Shiftpressed check for XT's
  16.        1.00d  7/23/91   Replaced CRT Readkey with interrupt to better
  17.                         support extended clone keyboards.
  18.        1.00e  8/17/91   Allowed keyboard stuffing in the idle hook.
  19.        1.00f  2/03/92   Added SetSlowdelay method
  20.        1.00g  3/09/92   Added support for vSetLeft
  21.        1.10   12/15/92  DPMI Update
  22.        1.10a  02/29/93  Corrected extended keyboard recognition problem
  23.        1.10b  05/03/93  Improved Double-Click reponse on fast systems --
  24.                         thanks Arnold!
  25.                         Added MouseOBJ.WaitForRelease method
  26. }
  27.  
  28.  
  29. INTERFACE
  30.  
  31. {$IFDEF DPMI}
  32. uses DOS,CRT,WINAPI;
  33. {$ELSE}
  34. uses DOS,CRT;
  35. {$ENDIF}
  36.  
  37. Const
  38.     StuffBufferSize = 30;
  39.  
  40. Type
  41.  
  42. InputIdleProc    = procedure;
  43. InputPressedProc = procedure(var W:word);
  44. CharProc         = procedure(W:word);
  45. CaseFunc         = function(Ch:char):char;
  46. CharSet = set of char;
  47.  
  48. pAlphabetOBJ = ^AlphabetOBJ;
  49. AlphabetOBJ = object
  50.    vUpper: CharSet;
  51.    vLower: CharSet;
  52.    vPunctuation: CharSet;
  53.    vUpCaseFunc: CaseFunc;
  54.    vLoCaseFunc: CaseFunc;
  55.    {methods...}
  56.    constructor Init;
  57.    procedure   AssignUpCaseFunc(Func:caseFunc);
  58.    procedure   AssignLoCaseFunc(Func:caseFunc);
  59.    procedure   SetUpper(Letters:CharSet);
  60.    procedure   SetLower(Letters:CharSet);
  61.    procedure   SetPunctuation(Letters:CharSet);
  62.    function    IsUpper(K:word): boolean;
  63.    function    IsLower(K:word): boolean;
  64.    function    IsLetter(K:word): boolean;
  65.    function    IsPunctuation(K:word): boolean;
  66.    function    GetUpCase(Ch:char):char;
  67.    function    GetLoCase(Ch:char):char;
  68.    destructor  Done;
  69. end; {AlphabetOBJ}
  70.  
  71. pMouseOBJ = ^MouseOBJ;
  72. MouseOBJ = object
  73.    vInstalled: boolean;    {is the system equipped with a mouse}
  74.    vButtons: byte;         {how many buttons on mouse}
  75.    vLeftHanded: boolean;   {is right button Enter?}
  76.    vIntr: integer;         {mouse interrupt number}
  77.    vVisible: boolean;      {is mouse cursor visible?}
  78.    vForceNoMouse: boolean; {uses monochrome color schemes}
  79.    {methods}
  80.    constructor Init;
  81.    procedure   SetLeft(On:boolean);
  82.    function    LeftHanded:boolean;
  83.    function    AdjustedButton(Button:integer):integer;
  84.    procedure   SetForceOff(On:boolean);
  85.    procedure   Reset;
  86.    function    Installed:boolean;
  87.    procedure   CheckInstalled;
  88.    procedure   Show;
  89.    procedure   Hide;
  90.    procedure   Move(X,Y : integer);
  91.    procedure   Confine(X1,Y1,X2,Y2:integer);
  92.    function    Released(Button: integer; var X,Y: byte): byte;
  93.    function    Pressed(Button: integer; var X,Y: byte): byte;
  94.    function    InZone(X1,Y1,X2,Y2: byte):boolean;
  95.    procedure   Location(var X,Y : byte);
  96.    procedure   Status(var L,C,R:boolean; var X,Y : byte);
  97.    procedure   WaitForRelease;
  98.    function    Visible: boolean;
  99.    procedure   SetMouseCursorStyle(OrdChar,Attr:byte);
  100.    function    GetButtons: byte;
  101.    destructor  Done;
  102. end; {MouseOBJ}
  103.  
  104. pKeyOBJ = ^KeyOBJ;
  105. KeyOBJ = object
  106.    vMouseMethod: byte;        {0-no mouse, 1-cursor emulation, 2-freefloating mouse}
  107.    vBuffer: array[1..StuffBufferSize] of word;
  108.    vBufferHead: word;         {next character from buffer}
  109.    vBufferTail:word;          {last valid character in buffer}
  110.    vLastkey: word;            {the last key pressed}
  111.    vLastX:byte;               {location of mouse when button pressed}
  112.    vLastY:byte;               {                -"-                  }
  113.    vClick: boolean;           {click after every keypress?}
  114.    vHorizSensitivity: byte;   {no of characters}
  115.    vVertSensitivity: byte;    {      -"-       }
  116.    vWaitForDouble: boolean;
  117.    vIdleHook: InputIdleProc;
  118.    vPressedHook: InputPressedProc;
  119.    vExtended : boolean;       {is it an extended keyboard}
  120.    vButtons : byte;
  121.    vSlowdelay: integer;       {time to wait for double click}
  122.    vLastPress: longint;
  123.    {methods...}
  124.    constructor Init;
  125.    procedure   SetSlowDelay(Del:integer);
  126.    procedure   AssignIdleHook(PassedProc: InputIdleProc);
  127.    procedure   AssignPressedHook(PassedProc: InputPressedProc);
  128.    function    Extended: boolean;
  129.    procedure   SetCaps(On:boolean);
  130.    procedure   SetNum(On:boolean);
  131.    procedure   SetScroll(On:boolean);
  132.    function    GetCaps:boolean;
  133.    function    GetNum:boolean;
  134.    function    GetScroll:boolean;
  135.    procedure   SetRepeatRate(Delay,Rate:byte);
  136.    procedure   SetFast;
  137.    procedure   SetSlow;
  138.    procedure   SetMouseMethod(Method:byte);
  139.    procedure   SetClick(On: boolean);
  140.    procedure   SetDouble(On:boolean);
  141.    function    GetDouble:boolean;
  142.    procedure   Click;
  143.    procedure   SetHoriz(Sensitivity:byte);
  144.    procedure   SetVert(Sensitivity:byte);
  145.    procedure   GetInput;
  146.    function    LastKey: word;
  147.    function    LastChar: char;
  148.    function    LastX: byte;
  149.    function    LastY: byte;
  150.    function    ExtendedKey(var K:byte):boolean;
  151.    function    ReadKey: char;
  152.    function    GetKey: word;
  153.    procedure   FlushBuffer;
  154.    procedure   StuffBuffer(W:word);
  155.    procedure   StuffBufferStr(Str:string);
  156.    function    Keypressed: boolean;
  157.    procedure   DelayKey(Mills:longint);
  158.    function    AltPressed:boolean;
  159.    function    CtrlPressed:boolean;
  160.    function    LeftShiftPressed: boolean;
  161.    function    RightShiftPressed: boolean;
  162.    function    ShiftPressed: boolean;
  163.    destructor  Done;
  164. end; {KeyOBJ}
  165.  
  166. procedure NoInputIdleHook;
  167. procedure NoInputPressedHook(var W:word);
  168. function  Altkey(K: word): word;
  169. procedure inputINIT;
  170.  
  171. VAR
  172.    AlphabetTOT: ^AlphabetOBJ;
  173.    Mouse: MouseOBJ;
  174.    Key:   KeyOBJ;
  175.  
  176. IMPLEMENTATION
  177. var
  178.    KeyStatusBits : ^word; {1.10}
  179.  
  180. {|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||}
  181. {                                                               }
  182. {     U N I T   P R O C E D U R E S   &   F U N C T I O N S     }
  183. {                                                               }
  184. {|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||}
  185.  
  186. {$F+}
  187.  procedure NoInputIdleHook;
  188.  {empty procs}
  189.  begin end; {NoInputIdleHook}
  190.  
  191.  procedure NoInputPressedHook(var W:word);
  192.  {empty procs}
  193.  begin end; {NoInputPressedHook}
  194.  
  195.  function EnglishUpCase(Ch:char):char;
  196.  {}
  197.  begin
  198.     EnglishUpCase := upcase(Ch);
  199.  end; {EnglishUpCase}
  200. (*
  201.  inline($58/$3C/$61/$72/$39/$3C/$7A/$76/$33/$3C/$84/$75/$02/$B0/$8E
  202.  /$3C/$94/$75/$02/$B0/$99/$3C/$81/$75/$02/$B0/$9A
  203.  /$3C/$87/$75/$02/$B0/$80/$3C/$86/$75/$02/$B0/$BF
  204.  /$3C/$82/$75/$02/$B0/$90/$3C/$91/$75/$02/$B0/$92
  205.  /$3C/$A4/$75/$02/$B0/$A5/$EB/03/90/$2C/$20);
  206. *)
  207.  function EnglishLoCase(Ch:char):char;
  208.  {}
  209.  begin
  210.    if Ch in ['A'..'Z'] then
  211.       EnglishLoCase := chr(ord(Ch) + 32)
  212.    else
  213.       EnglishLoCase := Ch;
  214.  end; {EnglishLoCase}
  215.  (*
  216.  inline($58/$3C/$41/$72/$39/$3C/$5A/$76/$33/$3C/$8E/$75/$02/$B0/$B4
  217.  /$3C/$99/$75/$02/$B0/$94/$3C/$9A/$75/$02/$B0/$81
  218.  /$3C/$8D/$75/$02/$B0/$87/$3C/$8F/$75/$02/$B0/$86
  219.  /$3C/$9D/$75/$02/$B0/$82/$3C/$92/$75/$02/$B0/$91
  220.  /$3C/$A5/$75/$02/$B0/$A4/$EB/03/90/$04/$20);
  221.  *)
  222. {$F-}
  223.  
  224. function Altkey(K: word): word;
  225. {returns the Alt keycode equivalent of a number or letter}
  226. var AK: word;
  227. begin
  228.    Case K of
  229.       65:AK:=286; 66:AK:=304; 67:AK:=302; 68:AK:=288; 69:AK:=274; 70:AK:=289;
  230.       71:AK:=290; 72:AK:=291; 73:AK:=279; 74:AK:=292; 75:AK:=293; 76:AK:=294;
  231.       77:AK:=306; 78:AK:=305; 79:AK:=280; 80:AK:=281; 81:AK:=272; 82:AK:=275;
  232.       83:AK:=287; 84:AK:=276; 85:AK:=278; 86:AK:=303; 87:AK:=273; 88:AK:=301;
  233.       89:AK:=277; 90:AK:=300; 48:AK:=385;
  234.    else if (K >= 49) and (K <= 57) then
  235.            AK := K + 327
  236.         else 
  237.            AK := 0;
  238.    end; {case}
  239.    AltKey := AK;
  240. end; {AltKey}
  241. {|||||||||||||||||||||||||||||||||||||||||||||||||}
  242. {                                                 }
  243. {     A l p h a b e t O B J    M E T H O D S      }
  244. {                                                 }
  245. {|||||||||||||||||||||||||||||||||||||||||||||||||}
  246. constructor AlphabetOBJ.Init;
  247. {}
  248. begin
  249.    vUpper := ['A'..'Z'];
  250.    vLower := ['a'..'z'];
  251.    vPunctuation := [',',';',':','.',' '];
  252.    AssignUpcaseFunc(EnglishUpcase);
  253.    AssignLocaseFunc(EnglishLocase);
  254. end; {AlphabetOBJ.Init}
  255.  
  256. procedure AlphabetOBJ.AssignUpCaseFunc(Func:caseFunc);
  257. {}
  258. begin
  259.    vUpCaseFunc := Func;
  260. end; {AlphabetOBJ.AssignUpCaseFunc}
  261.  
  262. procedure AlphabetOBJ.AssignLoCaseFunc(Func:caseFunc);
  263. {}
  264. begin
  265.    vLoCaseFunc := Func;
  266. end; {AlphabetOBJ.AssignLoCaseFunc}
  267.  
  268. procedure AlphabetOBJ.SetUpper(Letters:CharSet);
  269. {}
  270. begin
  271.    vUpper := Letters;
  272. end; {AlphabetOBJ.SetUpper}
  273.  
  274. procedure AlphabetOBJ.SetLower(Letters:CharSet);
  275. {}
  276. begin
  277.    vLower := Letters;
  278. end; {AlphabetOBJ.SetLower}
  279.  
  280. procedure AlphabetOBJ.SetPunctuation(Letters:CharSet);
  281. {}
  282. begin
  283.    vPunctuation := Letters;
  284. end; {AlphabetOBJ.SetPunctuation}
  285.  
  286. function AlphabetOBJ.IsUpper(K:word): boolean;
  287. {}
  288. begin
  289.    if K > 255 then
  290.      IsUpper := false
  291.    else
  292.      IsUpper := chr(K) in vUpper;
  293. end; {AlphabetOBJ.IsUpper}
  294.  
  295. function AlphabetOBJ.IsLower(K:word): boolean;
  296. {}
  297. begin
  298.    if K > 255 then
  299.      IsLower := false
  300.    else
  301.      IsLower := chr(K) in vLower;
  302. end; {AlphabetOBJ.IsLower}
  303.  
  304. function AlphabetOBJ.IsLetter(K:word): boolean;
  305. {}
  306. begin
  307.    if K > 255 then
  308.      IsLetter := false
  309.    else
  310.      IsLetter := (chr(K) in vUpper) or (chr(K) in vLower);
  311. end; {AlphabetOBJ.IsLetter}
  312.  
  313. function AlphabetOBJ.IsPunctuation(K:word): boolean;
  314. {}
  315. begin
  316.    if K > 255 then
  317.      IsPunctuation := false
  318.    else
  319.    IsPunctuation := chr(K) in vPunctuation;
  320. end; {AlphabetOBJ.IsPunctuation}
  321.  
  322. function AlphabetOBJ.GetUpCase(Ch:char):char;
  323. {}
  324. begin
  325.    GetUpCase := vUpCaseFunc(Ch);
  326. end; {AlphabetOBJ.GetUpCase}
  327.  
  328. function AlphabetOBJ.GetLoCase(Ch:char):char;
  329. {}
  330. begin
  331.    GetLoCase := vLoCaseFunc(Ch);
  332. end;{AlphabetOBJ.GetLoCase}
  333.  
  334. destructor AlphabetOBJ.Done;
  335. {}
  336. begin
  337. end; {AlphabetOBJ.Done}
  338. {|||||||||||||||||||||||||||||||||||||||||||}
  339. {                                           }
  340. {     M o u s e O B J    M E T H O D S      }
  341. {                                           }
  342. {|||||||||||||||||||||||||||||||||||||||||||}
  343. constructor MouseOBJ.Init;
  344. {}
  345. begin
  346.   CheckInstalled;
  347.   vForceNoMouse := false; {1.00a}
  348.   vLeftHanded := true;  {1.00g}
  349.   If vInstalled then
  350.   begin
  351.      vIntr := $33;
  352.      vVisible := false;
  353.      Reset;
  354.   end
  355.   else
  356.      vVisible := false;
  357. end; {MouseOBJ.Init}
  358.  
  359. procedure MouseOBJ.CheckInstalled;
  360. {}
  361. var
  362.   MouseInterruptPtr : pointer;
  363.  
  364.     Function InterruptLoaded:boolean;
  365.     var
  366.       Reg: registers;
  367.     begin
  368.        Reg.Ax := 0;
  369.        Intr($33,Reg);
  370.        InterruptLoaded :=  Reg.Ax <> 0;
  371.     end;
  372.  
  373. begin
  374.    MouseInterruptPtr := ptr($0000,$00CC);
  375.    vButtons := 0;
  376.    if (MouseInterruptPtr = nil)
  377.    or (byte(MouseInterruptPtr) = $CF) then
  378.       vInstalled := false          {don't call interrupt if vector is zero}
  379.    else
  380.       vInstalled := Interruptloaded;
  381. end; {MouseOBJ.CheckInstalled}
  382.  
  383. procedure MouseOBJ.SetForceOff(On:boolean); {1.00a}
  384. {}
  385. begin
  386.    vForceNoMouse := On;
  387. end; {MouseOBJ.SetForceOff}
  388.  
  389. procedure MouseOBJ.Reset;
  390. {}
  391. var Regs : registers;
  392. begin
  393.    if Installed then
  394.    begin
  395.       Regs.Ax := $00;
  396.       Intr(vIntr,Regs);
  397.       vButtons := Regs.Bx;
  398.       vVisible := false;
  399.    end;
  400. end; {MouseOBJ.Reset}
  401.  
  402. function MouseOBJ.Installed:boolean;
  403. {}
  404. begin
  405.     Installed := vInstalled;   {1.00b}
  406. end; {MouseOBJ.Installed}
  407.  
  408. procedure MouseOBJ.Show;
  409. {}
  410. var Regs : registers;
  411. begin
  412.    if (Installed) and (not vVisible) and (not vForceNoMouse) then
  413.    begin
  414.       Regs.Ax := $01;
  415.       Intr(vIntr,Regs);
  416.       vVisible := true;
  417.    end;
  418. end; {MouseOBJ.Show}
  419.  
  420. procedure MouseOBJ.Hide;
  421. {}
  422. var Regs : registers;
  423. begin
  424.    if Installed and vVisible then
  425.    begin
  426.       Regs.Ax := $02;
  427.       Intr(vIntr,Regs);
  428.       vVisible := false;
  429.    end;
  430. end; {MouseOBJ.Hide}
  431.  
  432. procedure MouseOBJ.Move(X,Y : integer);
  433. {X and Y are character positions not pixel positions}
  434. var Regs : registers;
  435. begin
  436.    if Installed then
  437.    begin
  438.       with Regs do
  439.       begin
  440.          Ax := $04;
  441.          Cx := pred(X*8);   {8 pixels per character}
  442.          Dx := pred(Y*8);   {         "-"          }
  443.       end; {with}
  444.       Intr(vIntr,Regs);
  445.    end;
  446. end; {MouseOBJ.Move}
  447.  
  448. procedure MouseOBJ.Confine(X1,Y1,X2,Y2:integer);
  449. {}
  450. var Regs : registers;
  451. begin
  452.    if Installed then
  453.       with Regs do
  454.       begin
  455.          {horizontal}
  456.          Ax := $07;
  457.          Cx := pred(X1*8);
  458.          Dx := pred(X2*8);
  459.          intr(vIntr,Regs);
  460.          {vertical}
  461.          Ax := $08;
  462.          Cx := pred(Y1*8);
  463.          Dx := pred(Y2*8);
  464.          intr(vIntr,Regs);
  465.       end;
  466. end; {MouseOBJ.Confine}
  467.  
  468. function MouseOBJ.AdjustedButton(Button:integer):integer;
  469. {}
  470. begin
  471.    if vLeftHanded or (Button > 2) then
  472.       AdjustedButton := Button
  473.    else if Button = 0 then
  474.       AdjustedButton := 1
  475.    else
  476.       AdjustedButton := 0;
  477. end; {MouseOBJ.AdjustedButton}
  478.  
  479. function MouseOBJ.Released(Button: integer; var X,Y: byte): byte;
  480. {}
  481. var Regs : registers;
  482. begin
  483.    if Installed then
  484.       with Regs do
  485.       begin
  486.          Ax := 6;
  487.          Bx := AdjustedButton(Button);
  488.          intr(vIntr,Regs);
  489.          Released := Bx;
  490.          X := succ(Cx div 8);
  491.          Y := succ(Dx div 8);
  492.       end;
  493. end; {MouseOBJ.Released}
  494.  
  495. function MouseOBJ.Pressed(Button: integer; var X,Y: byte): byte;
  496. {}
  497. var Regs : registers;
  498. begin
  499.    if Installed then
  500.       with Regs do
  501.       begin
  502.          Ax := 5;
  503.          Bx := AdjustedButton(Button);
  504.          intr(vIntr,Regs);
  505.          Pressed := Bx;
  506.          X := succ(Cx div 8);
  507.          Y := succ(Dx div 8);
  508.       end;
  509. end; {MouseOBJ.Pressed}
  510.  
  511. function MouseOBJ.InZone(X1,Y1,X2,Y2: byte):boolean;
  512. {}
  513. var X,Y: byte;
  514. begin
  515.    if Installed and vVisible then
  516.    begin
  517.       Location(X,Y);
  518.       InZone := (X >= X1) and (X <= X2) and (Y >= Y1) and (Y <= Y2);
  519.    end
  520.    else
  521.       InZone := false;
  522. end; {MouseOBJ.InZone}
  523.  
  524. procedure MouseOBJ.Location(var X,Y : byte);
  525. {}
  526. var Regs : registers;
  527. begin
  528.    if Installed then
  529.       with Regs do
  530.       begin
  531.          Ax := 3;
  532.          intr(vIntr,Regs);
  533.          X := succ(Cx div 8);
  534.          Y := succ(Dx div 8);
  535.       end; {with}
  536. end; {MouseOBJ.Location}
  537.  
  538. procedure MouseOBJ.Status(var L,C,R:boolean; var X,Y : byte);
  539. {}
  540. var Regs : registers;
  541. begin
  542.    if Installed then
  543.    begin
  544.       with Regs do
  545.       begin
  546.          Ax := 3;
  547.          intr(vIntr,Regs);
  548.          X := succ(Cx div 8);
  549.          Y := succ(Dx div 8);
  550.          if vLeftHanded then
  551.          begin
  552.             L := ((BX and $01) = $01);
  553.             R := ((BX and $02) = $02);
  554.          end
  555.          else
  556.          begin
  557.             R := ((BX and $01) = $01);
  558.             L := ((BX and $02) = $02);
  559.          end;
  560.          C := ((BX and $04) = $04);
  561.       end; {with}
  562.    end
  563.    else
  564.    begin
  565.       L := false;
  566.       C := false;
  567.       R := false;
  568.       X := 1;
  569.       Y := 1;
  570.    end;
  571. end; {MouseOBJ.Status}
  572.  
  573. procedure MouseOBJ.WaitForRelease;  {1.10b}
  574. {Waits for all mouse buttons to be released and clears the
  575.  pressed history}
  576. var
  577.   L,M,R: boolean;
  578.   X,Y,P: byte;
  579. begin
  580.    repeat
  581.       Status(L,M,R,X,Y);
  582.    until not L and not M and not R;
  583.    P := Released(0,X,Y);
  584.    P := Released(1,X,Y);
  585.    if vButtons > 2 then
  586.       P := Released(2,X,Y);
  587. end; {MouseOBJ.WaitForRelease}
  588.  
  589. procedure MouseOBJ.SetMouseCursorStyle(OrdChar,Attr: byte);
  590. var
  591.   Reg: registers;
  592. begin
  593.    if Installed then
  594.    begin
  595.       Reg.Ax := 10;
  596.       Reg.Bx := 0;        {software text cursor}
  597.       if Attr = 0 then
  598.          Reg.CX := $7700
  599.       else
  600.          Reg.Cx := $00;
  601.       Reg.Dl := OrdChar;
  602.       Reg.Dh := Attr;
  603.       Intr($33,Reg);
  604.    end;
  605. end; {MouseOBJ.SetMouseCursorStyle}
  606.  
  607. function MouseOBJ.Visible:boolean;
  608. {}
  609. begin
  610.    Visible := vVisible;
  611. end; {MouseOBJ.Visible}
  612.  
  613. function MouseOBJ.GetButtons: byte;
  614. {}
  615. begin
  616.    GetButtons := vButtons;
  617. end; {MouseOBJ.GetButtons}
  618.  
  619. procedure MouseOBJ.SetLeft(On:boolean);
  620. {}
  621. begin
  622.    vLeftHanded := On;
  623. end; {MouseOBJ.SetLeft}
  624.  
  625. function MouseOBJ.LeftHanded:boolean; {1.00g}
  626. begin
  627.    LeftHanded := vLeftHanded;
  628. end; {MouseOBJ.LeftHanded}
  629.  
  630. destructor MouseOBJ.Done;
  631. {}
  632. begin end;
  633. {|||||||||||||||||||||||||||||||||||||||}
  634. {                                       }
  635. {     K e y O B J    M e t h o d s      }
  636. {                                       }
  637. {|||||||||||||||||||||||||||||||||||||||}
  638. constructor KeyOBJ.Init;
  639. {}
  640. var
  641.    ExtStatus: pointer;  {1.10}
  642. {$IFDEF DPMI}
  643.    Sel:word;  {DPMI selector}
  644. {$ENDIF}
  645. begin
  646.    ExtStatus := ptr($0000,$0496);
  647. {$IFDEF DPMI}                     {1.10a}
  648.    vExtended := true;
  649.    Sel := AllocSelector(0);
  650.    if SetSelectorBase(sel,longint(hiword(longint(ExtStatus))) shl 4+loword(longint(ExtStatus))) <> 0 then
  651.    begin
  652.       SetSelectorLimit(sel,4);
  653.       ExtStatus := ptr(sel,0);
  654.       vExtended := (byte(ExtStatus^) <> 0);
  655.    end;
  656.    FreeSelector(sel);
  657. {$ELSE}
  658.    vExtended := (byte(ExtStatus^) <> 0);
  659. {$ENDIF}
  660.    vIdleHook := NoInputIdleHook;
  661.    vPressedHook := NoInputPressedHook;
  662.    vBufferHead := 1;
  663.    vBufferTail := 1;
  664.    vHorizSensitivity := 1;
  665.    vVertSensitivity := 1;
  666.    vClick := false;
  667.    vLastKey := 0;
  668.    vWaitForDouble := false;
  669.    vButtons := 0;
  670.    vSlowDelay := 350;    {was 200}
  671.    vLastPress := 0;
  672.    SetMouseMethod(2);
  673. end; {KeyOBJ.Init}
  674.  
  675. procedure KeyOBJ.SetSlowDelay(Del:integer);  {1.00f}
  676. {}
  677. begin
  678.    if Del >= 0 then
  679.      vSlowDelay := Del;
  680. end; {KeyOBJ.SetSlowDelay}
  681.  
  682. procedure KeyOBJ.AssignIdleHook(PassedProc: InputIdleProc);
  683. {}
  684. begin
  685.    vIdleHook := PassedProc;
  686. end; {KeyOBJ.AssignIdleHook}
  687.  
  688. procedure KeyOBJ.AssignPressedHook(PassedProc: InputPressedProc);
  689. {}
  690. begin
  691.    vPressedHook := PassedProc;
  692. end; {KeyOBJ.AssignPressedHook}
  693.  
  694. function KeyOBJ.Extended:boolean;
  695. {}
  696. begin
  697.     Extended := vExtended;
  698. end; {KeyOBJ.Extended}
  699.  
  700. procedure KeyOBJ.SetCaps(On:boolean);
  701. {}
  702. begin
  703.    If On then
  704.       KeyStatusBits^ := (KeyStatusBits^ or $40)
  705.    else
  706.       KeyStatusBits^ := (KeyStatusBits^ and $BF);
  707. end; {KeyOBJ.SetCaps}
  708.  
  709. procedure KeyOBJ.SetNum(On:boolean);
  710. {}
  711. begin
  712.    If On then
  713.       KeyStatusBits^ := (KeyStatusBits^ or $20)
  714.    else
  715.       KeyStatusBits^ := (KeyStatusBits^ and $DF);
  716. end; {KeyOBJ.SetNum}
  717.  
  718. procedure KeyOBJ.SetScroll(On:boolean);
  719. {}
  720. begin
  721.    If On then
  722.       KeyStatusBits^  := (KeyStatusBits^  or $10)
  723.    else
  724.       KeyStatusBits^  := (KeyStatusBits^  and $EF);
  725. end; {KeyOBJ.SetScroll}
  726.  
  727. function KeyOBJ.GetCaps:boolean;
  728. {}
  729. var CapsOnW : word;
  730. begin
  731.    CapsOnW := swap(KeyStatusBits^ );
  732.    GetCaps := (CapsOnW and $4000) <> 0;
  733. end; {KeyOBJ.GetCaps}
  734.  
  735. function KeyOBJ.GetNum:boolean;
  736. {}
  737. var NumOnW : word;
  738. begin
  739.    NumOnW := swap(KeyStatusBits^ );
  740.    GetNum := (NumOnW and $2000) <> 0;
  741. end; {KeyOBJ.GetNum}
  742.  
  743. function KeyOBJ.GetScroll:boolean;
  744. {}
  745. var ScrollOnW : word;
  746. begin
  747.    ScrollOnW := swap(KeyStatusBits^ );
  748.    GetScroll := (ScrollOnW and $1000) <> 0;
  749. end; {KeyOBJ.GetScroll}
  750.  
  751. procedure KeyOBJ.SetRepeatRate(Delay,Rate:byte);
  752. {}
  753. var Regs : registers;
  754. begin
  755.   with Regs do
  756.   begin
  757.      Ah := 3;
  758.      Al := 5;
  759.      Bl := Rate;
  760.      Bh := pred(Delay);
  761.      Intr($16,Regs);
  762.   end;
  763. end; {KeyOBJ.SetRepeatRate}
  764.  
  765. procedure KeyOBJ.SetFast;
  766. {}
  767. begin
  768.    SetRepeatRate(1,0);
  769. end; {KeyOBJ.SetFast}
  770.  
  771. procedure KeyOBJ.SetSlow;
  772. {}
  773. begin
  774.    SetRepeatRate(2,$14);
  775. end; {KeyOBJ.SetSlow}
  776.  
  777. procedure KeyOBJ.SetMouseMethod(Method:byte);
  778. {}
  779. begin
  780.    if (Method in [1,2]) and Mouse.Installed then
  781.    begin
  782.       vMouseMethod := Method;
  783.       vButtons := Mouse.GetButtons;
  784.    end
  785.    else
  786.       vMouseMethod := 0;
  787. end; {KeyOBJ.SetMouseMethod}
  788.  
  789. procedure KeyOBJ.SetHoriz(Sensitivity:byte);
  790. {}
  791. begin
  792.    vHorizSensitivity := Sensitivity;
  793. end; {KeyOBJ.SetHoriz}
  794.  
  795. procedure KeyOBJ.SetVert(Sensitivity:byte);
  796. {}
  797. begin
  798.    vVertSensitivity := Sensitivity;
  799. end; {KeyOBJ.SetHoriz}
  800.  
  801. procedure KeyOBJ.SetClick(On: boolean);
  802. {}
  803. begin
  804.    vClick := On;
  805. end; {KeyOBJ.SetClick}
  806.  
  807. procedure KeyOBJ.SetDouble(On:boolean);
  808. {}
  809. begin
  810.    vWaitForDouble := On;
  811. end; {KeyOBJ.SetDouble}
  812.  
  813. function KeyOBJ.GetDouble:boolean;
  814. {}
  815. begin
  816.    GetDouble := vWaitForDouble;
  817. end; {KeyOBJ.GetDouble}
  818.  
  819. procedure KeyOBJ.Click;
  820. {}
  821. begin
  822.    Sound(1000);
  823.    Sound(50);
  824.    delay(5);
  825.    nosound;
  826. end; {KeyOBJ.Click}
  827.  
  828. function KeyOBJ.ExtendedKey(var K:byte):boolean;  {1.00d}
  829. {}
  830. var Regs:Registers;
  831. begin
  832.    with Regs do
  833.    begin
  834.       if vExtended then
  835.         Ah := $10
  836.       else
  837.         Ah := $0;
  838.       intr($16,Regs);
  839.       if (Al = 0) or (Al = 224) then
  840.       begin
  841.          K := Ah;
  842.          ExtendedKey := true;
  843.       end
  844.       else
  845.       begin
  846.          K := al;
  847.          ExtendedKey := false;
  848.       end;
  849.    end;
  850. end; {KeyOBJ.ExtendedKey}
  851.  
  852. function KeyOBJ.ReadKey: char;          {1.00d}
  853. {CREDITS: Yanick Poirier and the folks in the Pascal International Echo - Thanks!
  854.  Replaces DOS Readkey, to improve extended keyboard support on clones}
  855. const ch:char = #0;
  856. var K:byte;
  857. begin
  858.    if Ch = #0 then
  859.    begin
  860.       if ExtendedKey(K) then
  861.       begin
  862.          Readkey := Ch;
  863.          Ch := chr(K);
  864.       end
  865.       else
  866.       begin
  867.          ReadKey := chr(K);
  868.          Ch := #0;
  869.       end;    
  870.    end
  871.    else
  872.    begin
  873.       Readkey := Ch;
  874.       Ch := #0; 
  875.    end;
  876. end; {KeyOBJ.ReadKey}
  877.  
  878. procedure KeyOBJ.GetInput;
  879. {waits for a keypress or mouse activity}
  880. Const
  881.    H = 40;
  882.    V = 13;
  883.    QwikDelay = 20;
  884. Var
  885.    L,C,R : boolean;
  886.    Action: boolean;
  887.    Finished: boolean;
  888.    ThisPress: Longint;
  889.    Temp, TempX,TempY,X,Y: byte;
  890.    Ch : char;
  891.    KeyWord : word;
  892.    InitDelay: longint;
  893.    LeftPresses, RightPresses, CenterPresses: word;
  894.    ButtonCombinations: byte;
  895.  
  896.    function ReadFromBuffer:boolean;  {1.00e}
  897.    {}
  898.    begin
  899.       if vBufferHead <> vBufferTail then  {read from object buffer}
  900.       begin
  901.          Keyword := vBuffer[vBufferHead];
  902.          if vBufferHead < StuffBufferSize then
  903.             Inc(vBufferHead)
  904.          else
  905.             vBufferHead := 1;
  906.          ReadFromBuffer := true;
  907.       end
  908.       else
  909.         ReadFromBuffer := false;
  910.    end;
  911.  
  912. begin
  913.    if vWaitForDouble then
  914.       InitDelay := vSlowdelay div 55  {for backward compatibility}
  915.    else
  916.       InitDelay := 5;
  917.    if not ReadFromBuffer then
  918.    begin
  919.       if vMouseMethod = 1 then
  920.          Mouse.Move(H,V);
  921.       Action := false;
  922.       Finished := false;
  923.       repeat
  924.          vIdleHook;   {call the users idle hook procedure}
  925.          if ReadFromBuffer then             {1.00e}
  926.             Finished := true
  927.          else if vMouseMethod > 0 then
  928.          begin
  929. {$IFDEF DPMI}                                             {1.10}
  930.             ThisPress := MemL[Seg0040:$006C];   {get time}
  931. {$ELSE}
  932.             ThisPress := MemL[$0040:$006C];   {get time}
  933. {$ENDIF}
  934.             Keyword := 0;
  935.             Mouse.Status(L,C,R,X,Y);
  936.             if L or R or C then {a button is being depressed}
  937.             begin
  938.                Finished := true;
  939.                { Next is the mouse speed up effect }
  940.                if ((ThisPress - vLastPress) <= Initdelay) then
  941.                begin
  942.                   LeftPresses := Mouse.Released(0,TempX,TempY);
  943.                   RightPresses := Mouse.Released(1,TempX,TempY);
  944.                   if vButtons > 2 then
  945.                      CenterPresses := Mouse.Released(2,TempX,TempY)
  946.                   else
  947.                      CenterPresses := 0;
  948.                   {Check for mouse combinations}
  949.                   ButtonCombinations :=   ord(LeftPresses > 0)
  950.                                         + 2*ord(RightPresses > 0)
  951.                                         + 4*ord(CenterPresses > 0);
  952.                   case ButtonCombinations of
  953.                      1: Keyword := 513;  {left button}
  954.                      2: Keyword := 514;  {right button}
  955.                      3: Keyword := 516;  {left+right}
  956.                      4: Keyword := 515;  {center button}
  957.                      5: Keyword := 517;  {left+center}
  958.                      6: Keyword := 518;  {center+right}
  959.                      7: Keyword := 519;  {all three buttons}
  960.                   end;
  961.                   if (vLastX = X) and (vLastY = Y) then
  962.                      if LeftPresses > 0 then
  963.                         if vLastkey = 513 then Keyword := 523      {double left}
  964.                      else if RightPresses > 0 then
  965.                         if vlastkey = 514 then Keyword := 524      {double right}
  966.                      else if CenterPresses > 0 then
  967.                         if vLastkey = 515 then Keyword := 525;     {double center}
  968.                end
  969.                else
  970.                begin
  971.                   delay(QwikDelay);
  972.                   Temp := Mouse.Pressed(0,TempX,TempY);   {clear the mouse buffers}
  973.                   Temp := Mouse.Pressed(1,TempX,TempY);
  974.                   Temp := Mouse.Pressed(2,TempX,TempY);
  975.                   Temp := Mouse.Released(0,TempX,TempY);
  976.                   Temp := Mouse.Released(1,TempX,TempY);
  977.                   Temp := Mouse.Released(2,TempX,TempY);
  978.                end;
  979.                vLastPress := ThisPress;
  980.                If Keyword = 0 then
  981.                begin
  982.                   if L then
  983.                      Keyword := 513
  984.                   else
  985.                     if R then
  986.                        Keyword := 514
  987.                     else
  988.                        Keyword := 515;
  989.                end;
  990.             end;
  991.             if vMouseMethod = 1 then
  992.             Case keyword of
  993.             513,523,515,516,517,519,523,525: keyword := 13;
  994.             514,518,524: keyword := 27;
  995.             else
  996.             begin
  997.                Mouse.Location(X,Y);
  998.                if Y - V > vVertSensitivity then
  999.                begin
  1000.                   Keyword :=  592;   {mouse down}        {1.00b}
  1001.                   Finished := true;
  1002.                end
  1003.                else if V - Y > vVertSensitivity then
  1004.                begin
  1005.                   Keyword :=  584;   {mouse up}
  1006.                   Finished := true;
  1007.                end
  1008.                else if X - H > vHorizSensitivity then
  1009.                begin
  1010.                   Keyword :=  587;   {mouse right}
  1011.                   Finished := true;
  1012.                end
  1013.                else if H - X > vHorizSensitivity then
  1014.                begin
  1015.                   Keyword :=  589;   {mouse left}
  1016.                   Finished := true;
  1017.                end
  1018.             end;
  1019.             end; {case}
  1020.          end; {if}
  1021.          If KeyPressed or Finished then
  1022.             Action := true;
  1023.       until Action;
  1024.       if not finished then
  1025.       begin
  1026.         Ch := ReadKey;
  1027.         if Ch = #0 then
  1028.         begin
  1029.             Ch := Readkey;
  1030.             Keyword := 256+ord(Ch);
  1031.             if (KeyWord >= 327) and (Keyword <= 339) then
  1032.             begin
  1033.                if AltPressed then
  1034.                   inc(Keyword,80)
  1035.                else if (ShiftPressed and vExtended) then  {1.00c}
  1036.                   inc(Keyword,100)
  1037.                else if CtrlPressed then
  1038.                   inc(Keyword,120);
  1039.             end;
  1040.         end
  1041.         else
  1042.            KeyWord := ord(Ch);
  1043.       end;
  1044.  
  1045.    end;
  1046.    vPressedHook(Keyword);
  1047.    vLastKey := Keyword;
  1048.    vLastX := X;
  1049.    vLastY := Y;
  1050.    if vClick then
  1051.       Click;
  1052. end; {KeyOBJ.GetInput}
  1053.  
  1054. function KeyOBJ.Lastkey: word;
  1055. {}
  1056. begin
  1057.    LastKey := vLastKey;
  1058. end; {KeyOBJ.Lastkey}
  1059.  
  1060. function KeyOBJ.GetKey: word;
  1061. {}
  1062. begin
  1063.    GetInput;
  1064.    GetKey := vLastKey;
  1065. end; {KeyOBJ.GetKey}
  1066.  
  1067. function KeyOBJ.LastChar: char;
  1068. {}
  1069. begin
  1070.    if vLastKey < 256 then
  1071.       LastChar := chr(LastKey)
  1072.    else
  1073.       LastChar := #0;
  1074. end; {KeyOBJ.LastChar}
  1075.  
  1076. function KeyOBJ.LastX: byte;
  1077. {}
  1078. begin
  1079.    LastX := vLastX;
  1080. end; {KeyOBJ.LastX}
  1081.  
  1082. function KeyOBJ.LastY: byte;
  1083. {}
  1084. begin
  1085.    LastY := vLastY;
  1086. end; {KeyOBJ.LastY}
  1087.  
  1088. procedure KeyOBJ.FlushBuffer;
  1089. {}
  1090. var Regs: registers;
  1091. begin
  1092.    vBufferTail := VBufferHead; {empty program buffer}
  1093.    with Regs do
  1094.    begin
  1095.       Ax := ($0c shl 8) or 6;
  1096.       Dx := $00ff;
  1097.    end;
  1098.    Intr($21,Regs);
  1099. end; {KeyOBJ.FlushBuffer}
  1100.  
  1101. procedure KeyOBJ.StuffBuffer(W:word);
  1102. {adds word to program keyboard buffer}
  1103. begin
  1104.    if (vBufferTail + 1 = vBufferHead)
  1105.    or ((vBufferTail = StuffBufferSize) and (vBufferHead = 1)) then
  1106.       exit; {buffer full}     
  1107.    vBuffer[vBufferTail] := W;
  1108.    if vBufferTail < StuffBufferSize then
  1109.       inc(vBufferTail)
  1110.    else
  1111.       vBufferTail := 1;
  1112. end; {KeyOBJ.StuffBuffer}
  1113.  
  1114. procedure KeyOBJ.StuffBufferStr(Str:string);
  1115. {}
  1116. var I,L : byte;
  1117. begin
  1118.    if Str <> '' then
  1119.    begin
  1120.       I := 1;
  1121.       L := length(Str);
  1122.       if L > StuffBufferSize then
  1123.          L := StuffBufferSize;
  1124.       while I <= L do
  1125.       begin
  1126.          StuffBuffer(ord(Str[I]));
  1127.          inc(I);
  1128.       end;
  1129.    end; 
  1130. end; {KeyOBJ.StuffBufferStr}
  1131.  
  1132. function KeyOBJ.Keypressed: boolean;   {1.00d}
  1133. {}
  1134. var Regs:Registers;
  1135. begin
  1136.    if (vBufferTail <> vBufferHead) then
  1137.       KeyPressed := true
  1138.    else
  1139.    begin
  1140.       if vExtended then
  1141.          Regs.Ah := $11
  1142.       else
  1143.          Regs.Ah := $01;
  1144.       intr($16,Regs);
  1145.       KeyPressed := (Regs.Flags and FZero) <> $40;
  1146.    end;
  1147. end; {KeyOBJ.KeyPressed}
  1148.  
  1149. procedure KeyOBJ.DelayKey(Mills:longint);
  1150. {}
  1151. var
  1152.   EndTime: longint;
  1153.   Now: longint;
  1154.  
  1155.    procedure SetNull;
  1156.    begin
  1157.       vLastKey := 0;
  1158.       vLastX := 0;
  1159.       vLastY := 0;
  1160.    end;
  1161.  
  1162. begin
  1163.    if Mills <= 0 then
  1164.       SetNull
  1165.    else
  1166.    begin
  1167. {$IFDEF DPMI}
  1168.       EndTime := MemL[seg0040:$006C] + trunc( (Mills/1000)*18.2);
  1169.       Repeat
  1170.          Now := MemL[seg0040:$006C];
  1171.       until Keypressed or (Now >= EndTime);
  1172. {$ELSE}
  1173.       EndTime := MemL[$40:$6C] + trunc( (Mills/1000)*18.2);
  1174.       Repeat
  1175.          Now := MemL[$40:$6C];
  1176.       until Keypressed or (Now >= EndTime);
  1177. {$ENDIF}
  1178.       if KeyPressed then
  1179.          GetInput
  1180.       else
  1181.          SetNull;
  1182.    end;
  1183. end; {KeyOBJ.DelayKey}
  1184.  
  1185. function KeyOBJ.AltPressed:boolean;
  1186. var
  1187.   AltW : word;
  1188. begin
  1189.    AltW := swap(KeyStatusBits^ );
  1190.    AltPressed := (AltW and $0800) <> 0;
  1191. end; {KeyOBJ.AltPressed}
  1192.  
  1193. function KeyOBJ.CtrlPressed:boolean;
  1194. var
  1195.   CtrlW : word;
  1196. begin
  1197.    CtrlW := swap(KeyStatusBits^ );
  1198.    CtrlPressed := (CtrlW and $0400) <> 0;
  1199. end; {KeyOBJ.CtrlPressed}
  1200.  
  1201. function KeyOBJ.LeftShiftPressed: boolean;
  1202. {}
  1203. var LSW : word;
  1204. begin
  1205.    LSW := swap(KeyStatusBits^ );
  1206.    LeftShiftPressed := (LSW and $0200) <> 0;
  1207. end; {LeftShiftPressed}
  1208.  
  1209. function KeyOBJ.RightShiftPressed: boolean;
  1210. {}
  1211. var RSW : word;
  1212. begin
  1213.    RSW := swap(KeyStatusBits^ );
  1214.    RightShiftPressed := (RSW and $0100) <> 0;
  1215. end; {RightShiftPressed}
  1216.  
  1217. function KeyOBJ.ShiftPressed: boolean;
  1218. {}
  1219. var SW : word;
  1220. begin
  1221.    SW := swap(KeyStatusBits^ );
  1222.    ShiftPressed := ((SW and $0200) <> 0) or ((SW and $0100) <> 0);
  1223. end; {ShiftPressed}
  1224.  
  1225. destructor KeyOBJ.Done;
  1226. {}
  1227. begin end; {of desc KeyOBJ.Done}
  1228. {|||||||||||||||||||||||||||||||||||||||||||||||}
  1229. {                                               }
  1230. {     U N I T   I N I T I A L I Z A T I O N     }
  1231. {                                               }
  1232. {|||||||||||||||||||||||||||||||||||||||||||||||}
  1233. procedure InputInit;
  1234. {initilizes objects and global variables}
  1235. begin
  1236. {$IFDEF DPMI}
  1237.    KeyStatusBits := ptr(seg0040,$0017);
  1238. {$ELSE}
  1239.    KeyStatusBits := ptr($0040,$0017);
  1240. {$ENDIF}
  1241.    new(AlphabetTOT,Init);
  1242.    Mouse.Init;
  1243.    Key.Init;
  1244. end;
  1245.  
  1246. {end of unit - add intialization routines below}
  1247. {$IFNDEF OVERLAY}
  1248. begin
  1249.    InputInit;
  1250. {$ENDIF}
  1251. end.
  1252.